home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / bgerror.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  1.3 KB  |  60 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test the bgerror command.
  2. # It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1997 Sun Microsystems, Inc.
  5. #
  6. # See the file "license.terms" for information on usage and redistribution
  7. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  8. #
  9. # SCCS: @(#) bgerror.test 1.1 97/08/06 09:28:30
  10.  
  11. if {[info commands test] == ""} {
  12.     source defs
  13. }
  14.  
  15.  
  16. test bgerror-1.1 {bgerror / tkerror compat} {
  17.     set errRes {}
  18.     proc tkerror {err} {
  19.     global errRes;
  20.     set errRes $err;
  21.     }
  22.     after 0 {error err1}
  23.     vwait errRes;
  24.     set errRes;
  25. } err1
  26.  
  27. test bgerror-1.2 {bgerror / tkerror compat / accumulation} {
  28.     set errRes {}
  29.     proc tkerror {err} {
  30.     global errRes;
  31.     lappend errRes $err;
  32.     }
  33.     after 0 {error err1}
  34.     after 0 {error err2}
  35.     after 0 {error err3}
  36.     update
  37.     set errRes;
  38. } {err1 err2 err3}
  39.  
  40. test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} {
  41.     set errRes {}
  42.     proc tkerror {err} {
  43.     global errRes;
  44.     lappend errRes $err;
  45.     return -code break "skip!";
  46.     }
  47.     after 0 {error err1}
  48.     after 0 {error err2}
  49.     after 0 {error err3}
  50.     update
  51.     set errRes;
  52. } err1
  53.  
  54. catch {rename tkerror {}}
  55.  
  56. # some testing of the default error dialog
  57. # would be needed too, but that's not easy at all
  58. # to emulate.
  59.  
  60.